home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / runtime / cfuns.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-02-09  |  50.1 KB  |  2,205 lines
  1. /* cfuns.c
  2.  *
  3.  * COPYRIGHT (c) 1990 by AT&T Bell Laboratories.
  4.  *
  5.  * These are the C functions that are callable from ML (via REQ_CALLC).
  6.  */
  7.  
  8. #include "ml_os.h"
  9. #ifdef THINK_C
  10. #include <unix.h>
  11. #include <fcntl.h>
  12. #include <errno.h>
  13. #include "MacOS.dep.h"
  14. #else
  15. #include <sys/socket.h>
  16. #include <sys/un.h>
  17. #include <netinet/in.h>
  18. #include <sys/stat.h>
  19. #include <sys/errno.h>
  20. #ifdef V9
  21. #include <sys/filio.h>
  22. #include <sys/ttyio.h>
  23. #else
  24. #include <sys/ioctl.h>
  25. #include <sys/file.h>
  26. #ifndef HPUX
  27. #include <sys/time.h>
  28. #endif
  29. #endif
  30. #ifndef HPUX
  31. #include <sys/param.h>
  32. #endif
  33. #if (defined(SPARC) && !defined(MACH))
  34. #include <vfork.h>    /* tells sparc optimizer about vfork */
  35. #endif
  36. #include <sys/wait.h>
  37. #endif THINK_C
  38. #ifdef HPUX
  39. #include <sys/utsname.h>
  40. #endif
  41.  
  42. #include "ml_state.h"
  43. #include "ml_types.h"
  44. #include "cause.h"
  45. #include "prim.h"
  46.  
  47. /* Imported from mp.c */
  48. extern void ml_release_proc ();
  49. extern void ml_acquire_proc ();
  50. extern void ml_spin_lock ();
  51. extern void ml_max_procs ();
  52.  
  53. /* do a system call, restarting it if interrupted */
  54. #define DO_SYSCALL(CALL,sts) {                    \
  55.     while (((sts = CALL) == -1) && (errno == EINTR))    \
  56.             continue;                        \
  57.     }
  58.  
  59. /* return a value to the calling ML code */
  60. #define RETURN(msp,r)    {        \
  61.     msp->ml_arg = (r);            \
  62.     return;}
  63.  
  64. /* return sts to the calling ML code, but raise an exception if an error occured */
  65. #define CHK_RETURN(msp,sts)    {        \
  66.     if (sts == -1) raise_syserror(msp, 0);    \
  67.     else RETURN(msp, INT_CtoML(sts)) }
  68.  
  69. /* return unit to the calling ML code, but raise an exception if an error occured */
  70. #define CHK_RETURN_UNIT(msp,sts)    {        \
  71.     if (sts == -1) raise_syserror(msp, 0);    \
  72.     else RETURN(msp, ML_unit) }
  73.  
  74. extern int        errno;
  75.  
  76. /* backup_kont:
  77.  * When a signal interrupts a blocking select call, this is called to
  78.  * back-up the continuation to re-try the select.
  79.  * NOTE: the call_c entry does not save the link register, so we must
  80.  * set it here.
  81.  */
  82. static void backup_kont (msp)
  83.     MLState_ptr        msp;
  84. {
  85.     msp->ioWaitFlag    = 0;
  86.     msp->ml_closure    = PTR_CtoML(callc_v+1);
  87.     msp->ml_pc        =
  88.     msp->ml_linkreg    = CODE_ADDR(PTR_CtoML(callc_v+1));
  89. }
  90.  
  91. #ifdef V9
  92.  
  93. #define MAX_TIMEOUT    0x7fffffff
  94.  
  95. /* v9_select:
  96.  * A 4.2bsd interface to V9 select.
  97.  */
  98. static int v9_select (width, rfds, wfds, efds, *timeout)
  99.     int            width;
  100.     fd_set        *rfds, *wfds, *efds;
  101.     struct timeval  *timeout;
  102. {
  103.     int            t, sts;
  104.  
  105.     if (timeout == 0)
  106.     t = MAX_TIMEOUT;
  107.     else {
  108.     t = timeout.tv_usec / 1000;
  109.     if (timeout.tv_sec > (MAX_TIMEOUT/1000)-t)
  110.         t = MAX_TIMEOUT;
  111.     else
  112.         t += (t.tv_sec * 1000);
  113.     }
  114.  
  115.     if (efds != NULL)
  116.     return -1;  /* exceptional conditions not supported on V9 */
  117.  
  118.     DO_SYSCALL(select(width, rfds, wfds, t), sts);
  119.     return sts;
  120. }
  121.  
  122. #define select v9_select
  123. #endif V9
  124.  
  125.  
  126. /* raise_syserror:
  127.  * Raise the ML exception SysError with the errno and error string as the argument
  128.  * pair.  If alt_msg is non-zero, then use it as the error string and use -1 as the
  129.  * errno.
  130.  */
  131. void raise_syserror (msp, alt_msg)
  132.     MLState_ptr        msp;
  133.     char        *alt_msg;
  134. {
  135.     extern int        sys_nerr, syserror_id0[];
  136.     extern char        *sys_errlist[];
  137.     ML_val_t        s, arg, exn;
  138.  
  139.     if (alt_msg != 0) {
  140.     s = ML_alloc_string (msp, alt_msg);
  141.     errno = -1;
  142.     }
  143. #ifndef THINK_C
  144.     else if ((0 <= errno) && (errno < sys_nerr))
  145.     s = ML_alloc_string (msp, sys_errlist[errno]);
  146. #endif
  147.     else {
  148.     char        buf[32];
  149.     sprintf(buf, "<unknown error %d>", errno);
  150.     s = ML_alloc_string (msp, buf);
  151.     }
  152.  
  153.     REC_ALLOC2 (msp, arg, INT_CtoML(errno), s);
  154.     REC_ALLOC2 (msp, exn, PTR_CtoML(syserror_id0+1), arg);
  155.     msp->fault_exn = exn;
  156.  
  157.     raise_ml_exn (msp);
  158. }
  159.  
  160.  
  161. #ifdef THINK_C
  162. #include <stdarg.h>
  163. #define SYS_read    3
  164. #define SYS_write    4
  165. #define SYS_open    5
  166. #define SYS_close    6
  167.  
  168. void raise_ThinkC_error(msp)
  169.     MLState_ptr        msp;
  170.     {
  171.     raise_syserror(msp, "unimplemented");
  172. }
  173.  
  174. int syscall(int n, ...)
  175.     {
  176.     int arg0, arg1, arg2;
  177.     int i = -1;
  178.     va_list xp;
  179.     
  180.     va_start(xp, n);
  181.     arg0 = va_arg(xp, int);
  182.     arg1 = va_arg(xp, int);
  183.     arg2 = va_arg(xp, int);
  184.     va_end(xp);
  185.  
  186.     switch(n) {
  187.         case SYS_read: {
  188.         char *buf = (char *) arg1;
  189.         int  fd = (int) arg0;
  190.         
  191.         if (fd == 0) {    /* stdin */
  192.             fgets(buf, (int) arg2, stdin);
  193.             i = strlen(buf); 
  194.         }
  195.         else
  196.             i = read(fd, buf, arg2);
  197.         break;
  198.         }
  199.         case SYS_write: {
  200.         int fd = (int) arg0;
  201.         char *buffer = (char *) arg1;
  202.         unsigned nbytes = (unsigned) arg2;
  203.  
  204.         i = write(fd, buffer, nbytes);
  205.         break;
  206.         }
  207.         case SYS_open: {
  208. #ifdef IGNORE_THIS
  209.             /* never reached!? asm{ DC.W 0xA9FF } /* Debug */
  210.         /* lousy trick to avoid '\r'
  211.         if (strcmp((char*)arg0,"boot/assembly.sig") == 0)
  212.             open_mode = O_TEXT | O_RDONLY;
  213.              */
  214.         /* after boot/..., the only time we need binary mode again */
  215.         /* is when we export i.e. arg1 == 1537 */
  216.         if (arg1==1537)
  217.             /* 'exportML' */
  218.             i = open((char *) arg0, (O_WRONLY | O_CREAT | O_TRUNC | O_BINARY)); 
  219.         else if (0)
  220.             /* 'open_in' statement */;
  221.         else
  222.             /* 'use' statement */
  223.             i = open((char *) arg0, (O_TEXT | O_RDONLY));  /* was open_mode */
  224. #endif
  225.         i = eopen((char *) arg0, (arg1==1537)?(O_WRONLY | O_CREAT | O_TRUNC):(O_RDONLY));
  226.         break;
  227.         }
  228.         case SYS_close:
  229.         i = close((int) arg0);
  230.         break;
  231.         default:
  232.         e_raise(SIGSYS);
  233.         break;
  234.         }
  235.     return i;
  236. }
  237.  
  238. int fionread(int fd) 
  239. {
  240.     int pos,sz;
  241.  
  242.     if (isatty(fd)) return 1;    /* console always has something?! */
  243.     pos = tell(fd);            /* get current position */
  244.     if(pos < 0) return(pos);    /* error */
  245.     sz = lseek(fd, 0, SEEK_END);    /* get file size (inefficiently) */
  246.     if(sz < 0) return(sz);        /* error */
  247.     pos = lseek(fd, pos, SEEK_SET);    /* recover position */
  248.     if(pos < 0) return(pos);    /* error */
  249.      return (sz - pos);
  250. }
  251.  
  252. #endif
  253.  
  254.  
  255. #define MAX_SYSCALL_ARGS    6
  256.  
  257. /* ml_syscall : (int * string list) -> int
  258.  * Perform the requested system call with the given arguments.  Unboxed
  259.  * values are converted to C ints.
  260.  */
  261. #ifdef AIX
  262. void ml_syscall(msp,arg)
  263.     MLState_ptr           msp;
  264.     ML_val_t      arg;
  265. {
  266.     raise_syserror (msp, "ml_syscall: Not implemented");
  267.     return;
  268. }
  269. #else
  270. void ml_syscall (msp, arg)
  271.     MLState_ptr        msp;
  272.     ML_val_t        arg;
  273. {
  274.     int            code = REC_SELINT(arg, 0);
  275.     register ML_val_t p = REC_SEL(arg, 1);
  276.     int            av[MAX_SYSCALL_ARGS];
  277.     register int    i, r;
  278.     register ML_val_t v;
  279.  
  280. #if (MAX_PROCS > 1)
  281.     if (code == 1) /* exit */ {
  282.       mp_shutdown(msp, INT_MLtoC(ML_hd(p)));
  283.     }
  284. #endif
  285. #if  defined(RISCos) || defined(SGI)
  286.     code += 1000;  /* adjust syscall code for RISCos */
  287. #endif
  288.     for (i = 0; p != ML_nil; p = ML_tl(p), i++) {
  289.     if (OBJ_isBOXED(v = ML_hd(p)))
  290.         av[i] = (int)PTR_MLtoC(v);
  291.     else
  292.         av[i] = INT_MLtoC(v);
  293.     }
  294. #ifdef THINK_C
  295.     if (!  setjmp(msp->SysCallEnv))
  296. #else
  297.     if (! _setjmp(msp->SysCallEnv))
  298. #endif THINK_C
  299.     switch (i) {
  300.       case 0:
  301.         r = syscall(code); break;
  302.       case 1:
  303.         r = syscall(code, av[0]); break;
  304.       case 2:
  305.         r = syscall(code, av[0], av[1]); break;
  306.       case 3:
  307.         r = syscall(code, av[0], av[1], av[2]); break;
  308.       case 4:
  309.         r = syscall(code, av[0], av[1], av[2], av[3]); break;
  310.       case 5:
  311.         r = syscall(code, av[0], av[1], av[2], av[3], av[4]); break;
  312.       case 6:
  313.         r = syscall(code, av[0], av[1], av[2], av[3], av[4], av[5]); break;
  314.       default:
  315.         raise_syserror (msp, "ml_syscall: too many args");
  316.         return;
  317.     }
  318.     else {
  319.       /* a SIGSYS occurred (because of a bad syscall) */
  320. #ifndef THINK_C
  321.     sigsetmask (0);  /* re-enable signals */
  322. #endif THINK_C
  323.     raise_syserror (msp, "bad syscall");
  324.     return;
  325.     }
  326.  
  327.     if (r == -1) {
  328.     if (errno == EINTR)
  329.         backup_kont(msp);
  330.     else
  331.         raise_syserror(msp, 0);
  332.     return;
  333.     }
  334.     else
  335.     RETURN(msp, INT_CtoML(r));
  336.  
  337. } /* end of ml_syscall. */
  338. #endif
  339.  
  340.  
  341. /* ml_openf : (string * int) -> int
  342.  * Open a file and return the file descriptor.
  343.  */
  344. void ml_openf (msp, arg)
  345.     MLState_ptr        msp;
  346.     ML_val_t        arg;
  347. {
  348.     char        *path = (char *)REC_SELPTR(arg, 0);
  349.     int            mode = REC_SELINT(arg, 1);
  350.     int            fd, flags;
  351.  
  352. #if defined(V9) || (defined(HPUX)  && defined(M68))
  353.     switch (mode) {
  354.       case 0: /* READ */
  355.     DO_SYSCALL(open(path, 0), fd);
  356.     break;
  357.       case 1: /* WRITE */
  358.     DO_SYSCALL(creat(path, 0666), fd);
  359.     break;
  360.       case 2: /* APPEND */
  361.     DO_SYSCALL(open(path, 1), fd);
  362.     if (fd == -1)
  363.         DO_SYSCALL(creat(path, 0666), fd)
  364.     else if (lseek(fd, 0, L_INCR) == -1)
  365.         fd = -1;
  366.     break;
  367.     }
  368. #else
  369.     /*
  370.     ** Note: The O_RDWR flag in case 1:, is a temporary in order
  371.     ** to support exportML for the HPPA. The combination of
  372.     ** flags will not affect previous applications that opened
  373.     ** files for writing only -lg.
  374.     */
  375.  
  376.     switch (mode) {
  377.       case 0: flags = (O_RDONLY); break;
  378.       case 1: flags = (O_RDWR|O_TRUNC|O_CREAT); break;
  379.       case 2: flags = (O_WRONLY|O_APPEND|O_CREAT); break;
  380.     }
  381. #ifdef THINK_C
  382.     DO_SYSCALL(eopen (path, flags), fd);
  383. #else
  384.     DO_SYSCALL(open (path, flags, 0666), fd);
  385. #endif
  386. #endif
  387.  
  388.     CHK_RETURN(msp, fd);
  389.  
  390. } /* end of ml_openf */
  391.  
  392.  
  393. /* ml_closef : int -> unit
  394.  */
  395. void ml_closef (msp, arg)
  396.     MLState_ptr        msp;
  397.     ML_val_t        arg;
  398. {
  399.     int            sts;
  400.  
  401.     DO_SYSCALL (close(INT_MLtoC(arg)), sts);
  402.     CHK_RETURN_UNIT(msp, sts);
  403.  
  404. } /* end of ml_closef */
  405.  
  406. /* ml_connect_unix : string -> fd
  407.  * Open a client-side UNIX domain STREAM socket connection on the given pathname.
  408.  */
  409. void ml_connect_unix (msp, arg)
  410.     MLState_ptr        msp;
  411.     ML_val_t        arg;
  412. {
  413. #ifdef THINK_C
  414.     /* Mac does not have sockets */
  415.     raise_ThinkC_error(msp);
  416. #else
  417.     char        *path = (char *)PTR_MLtoC(arg);
  418.     struct sockaddr_un sock;
  419.     int            fd, len, sts;
  420.  
  421.     DO_SYSCALL (socket(PF_UNIX, SOCK_STREAM, 0), fd);
  422.     if (fd != -1) {
  423.     sock.sun_family = AF_UNIX;
  424.     strcpy (sock.sun_path, path);
  425. #ifdef AIX
  426.     len = strlen(path)+sizeof(sock.sun_len)+sizeof(sock.sun_family)+1;
  427.     sock.sun_len = len;
  428. #else
  429.     len = strlen(path)+sizeof(sock.sun_family);
  430. #endif
  431.     DO_SYSCALL (connect(fd, (struct sockaddr *)&sock, len), sts);
  432.     if (sts != -1) {
  433.         RETURN(msp, INT_CtoML(fd));
  434.     }
  435.     else {
  436.         int        olderrno = errno;
  437.         close (fd);
  438.         errno = olderrno;
  439.     }
  440.     }
  441.     raise_syserror(msp, 0);
  442.  
  443. #endif
  444. } /* end of ml_connect_unix */
  445.  
  446. /* ml_connect_inet : (string * string) -> fd
  447.  * Open a client-side INET domain STREAM socket connection to the given host/port.
  448.  * Currently the host must be specified as a string of the form "d.d.d.d" where
  449.  * the d's are decimal numbers from 0 to 255 separated by "."s.  The port is specified
  450.  * as a string representation of a decimal port number.
  451.  * Note: eventually this interface will be extended to use symbolic names.
  452.  */
  453. void ml_connect_inet (msp, arg)
  454.     MLState_ptr     msp;
  455.     ML_val_t        arg;
  456. {
  457. #ifdef THINK_C
  458.     /* Mac does not have sockets */
  459.     raise_ThinkC_error(msp);
  460. #else
  461.     char        *hostname = (char *)REC_SELPTR(arg, 0);
  462.     char        *port = (char *)REC_SELPTR(arg, 1);
  463.     struct sockaddr_in saddr;
  464.     int            fd, s, i, sts;
  465.  
  466. #if defined(SUNOS) || (defined(BSD) && defined(MIPS)) || defined(NeXT) || defined(AUX) || defined(HPPA)
  467.     DO_SYSCALL (socket(PF_INET, SOCK_STREAM, 0), fd);
  468.     if (fd != -1) {
  469.     saddr.sin_family = AF_INET;
  470.     saddr.sin_port = htons(atoi(port));
  471.     bzero(saddr.sin_zero, sizeof(saddr.sin_zero));
  472.     s = i = 0;
  473.     do {
  474.         s = (s << 8) | atoi(hostname);
  475.         while (*hostname && (*hostname != '.'))
  476.         hostname++;
  477.     } while (*hostname++ != '\0');
  478.     saddr.sin_addr.s_addr = htonl(s);
  479.     DO_SYSCALL (connect(fd, (struct sockaddr *)&saddr, sizeof(saddr)), sts);
  480.     if (sts == 0) {
  481.         RETURN(msp, INT_CtoML(fd));
  482.     }
  483.     else {
  484.         int        olderrno = errno;
  485.         close (fd);
  486.         errno = olderrno;
  487.     }
  488.     }
  489.     raise_syserror(msp, 0);
  490. #else
  491.     raise_syserror(msp, "unimplemented");
  492. #endif
  493. #endif
  494. } /* end of ml_connect_unix */
  495.  
  496.  
  497. /* ml_link : (bool * string * string) -> unit
  498.  * Create a link (or symbolic link).
  499.  */
  500. void ml_link (msp, arg)
  501.     MLState_ptr     msp;
  502.     ML_val_t        arg;
  503. {
  504. #ifdef THINK_C
  505.     /* Mac has links, but how to access from C? */
  506.     raise_ThinkC_error(msp);
  507. #else
  508.     ML_val_t        is_sym = REC_SEL(arg, 0);
  509.     char        *name = (char *)REC_SELPTR(arg, 1);
  510.     char        *lname = (char *)REC_SELPTR(arg, 2);
  511.     int            sts;
  512.  
  513.     if (is_sym == ML_true)
  514.     sts = symlink (name, lname);
  515.     else
  516.     sts = link (name, lname);
  517.  
  518.     CHK_RETURN(msp, sts);
  519. #endif
  520. } /* end of ml_link */
  521.  
  522.  
  523. /* ml_unlink : string -> unit
  524.  */
  525. void ml_unlink (msp, arg)
  526.     MLState_ptr        msp;
  527.     ML_val_t        arg;
  528. {
  529. #ifdef THINK_C
  530.     /* Mac has links, but how to access from C? */
  531.     raise_ThinkC_error(msp);
  532. #else
  533.     int            sts;
  534.  
  535.     DO_SYSCALL(unlink((char *)PTR_MLtoC(arg)), sts);
  536.     CHK_RETURN_UNIT(msp, sts);
  537. #endif
  538. } /* end of ml_unlink */
  539.  
  540. /* ml_dup : int -> int
  541.  */
  542. void ml_dup (msp, arg)
  543.     MLState_ptr        msp;
  544.     ML_val_t        arg;
  545. {
  546. #ifdef THINK_C
  547.     /* Mac has links, but how to access from C? */
  548.     raise_ThinkC_error(msp);
  549. #else
  550.     int            fd;
  551.  
  552.     DO_SYSCALL(dup(INT_MLtoC(arg)), fd);
  553.     CHK_RETURN(msp, fd);
  554. #endif
  555. } /* end of ml_dup */
  556.  
  557. /* ml_wait_for_in : fd -> unit
  558.  * Wait for input on the given file descriptor.
  559.  */
  560. void ml_wait_for_in (msp, arg)
  561.     MLState_ptr     msp;
  562.     ML_val_t        arg;
  563. {
  564.     int            fd = INT_MLtoC(arg), sts;
  565. #ifdef THINK_C
  566.     /* Mac version not done yet!? */
  567.     RETURN(msp, ML_unit);
  568.     /*
  569.     raise_ThinkC_error(msp);
  570.     */
  571. #else
  572.     fd_set        rfds;
  573.  
  574.     if (msp->inSigHandler || msp->maskSignals
  575.     || ((! _setjmp (msp->SysCallEnv)) && 
  576.     (((msp->ioWaitFlag = 1), (msp->NumPendingSigs == 0))))) {
  577. #ifdef RISCos
  578.     /* problem with select and pipes */
  579.     sts = 0;
  580. #else
  581.     FD_ZERO(&rfds);
  582.     FD_SET(fd, &rfds);
  583.     sts = select(fd+1, &rfds, 0, 0, 0);
  584. #endif
  585.     msp->ioWaitFlag = 0;
  586.     }
  587.     else {
  588.     backup_kont(msp);
  589.     sigsetmask (0);  /* re-enable signals */
  590.     return;
  591.     }
  592.  
  593.     if (sts == -1) {
  594.     if (errno == EINTR)
  595.         backup_kont(msp);
  596.     else
  597.         raise_syserror(msp, 0);
  598.     return;
  599.     }
  600.  
  601.     RETURN(msp, ML_unit);
  602. #endif
  603. } /* end of ml_wait_for_in. */
  604.  
  605.  
  606. /* ml_read : (int * bytearray * int) -> int
  607.  * Read data from the specified file into the given bytearray.  Return the
  608.  * number of bytes read.
  609.  */
  610. void ml_read (msp, arg)
  611.     MLState_ptr     msp;
  612.     ML_val_t        arg;
  613. {
  614.     int            fd = REC_SELINT(arg, 0);
  615.     char        *buf = (char *)REC_SELPTR(arg, 1);
  616.     int            nbytes = REC_SELINT(arg, 2);
  617.     int            n;
  618.  
  619. #ifdef THINK_C
  620.     if (fd == 0) {    /* stdin */
  621.     if(fgets(buf, nbytes, stdin))
  622.         n = strlen(buf);
  623.     else
  624.         n = -1;
  625.     }
  626.     else
  627.     DO_SYSCALL (read (fd, buf, nbytes), n);
  628. #else
  629.     DO_SYSCALL (read (fd, buf, nbytes), n);
  630. #endif
  631.     CHK_RETURN(msp, n);
  632.  
  633. } /* end of ml_read */
  634.  
  635. /* ml_readi : (int * bytearray * int * int) -> int
  636.  * Read data from the specified file into the given bytearray, starting at
  637.  * offset.  Return the number of bytes read.
  638.  */
  639. void ml_readi (msp, arg)
  640.     MLState_ptr     msp;
  641.     ML_val_t        arg;
  642. {
  643.     int            fd = REC_SELINT(arg, 0);
  644.     char        *buf = (char *)REC_SELPTR(arg, 1);
  645.     char        *start = buf + REC_SELINT(arg, 2);
  646.     int            nbytes = REC_SELINT(arg, 3);
  647.     int            n;
  648.  
  649. #ifdef THINK_C
  650.     DO_SYSCALL (read (fd, start, nbytes), n);  /* right!? */
  651. #else
  652.     DO_SYSCALL (read (fd, buf, nbytes), n);
  653. #endif
  654.     CHK_RETURN(msp, n);
  655.  
  656. } /* end of ml_readi */
  657.  
  658.  
  659. /* write_all:
  660.  * Write the requested number of bytes from the buffer.  Return 0 on success,
  661.  * and -1 on errors.
  662.  */
  663. static int write_all (fd, buf, nbytes)
  664.     int            fd;
  665.     char        *buf;
  666.     int            nbytes;
  667. {
  668.     register int    n;
  669.  
  670.     while (nbytes > 0) {
  671.     DO_SYSCALL (write (fd, buf, nbytes), n);
  672.     if (n > 0) {
  673.         nbytes -= n;
  674.         buf += n;
  675.     }
  676.     else
  677.         return -1;
  678.     }
  679.     return 0;
  680.  
  681. } /* end of write_all. */
  682.  
  683. /* ml_write : (int * bytearray * int) -> unit
  684.  * Write data from the given bytearray to the specified file.  Return the
  685.  * number of bytes written.
  686.  */
  687. void ml_write (msp, arg)
  688.     MLState_ptr     msp;
  689.     ML_val_t        arg;
  690. {
  691.     int            sts;
  692.  
  693.     sts = write_all (
  694.         REC_SELINT(arg, 0),
  695.         (char *)REC_SELPTR(arg, 1),
  696.         REC_SELINT(arg, 2));
  697.  
  698.     if (sts == -1)
  699.     raise_syserror(msp, 0);
  700.     else
  701.     RETURN(msp, ML_unit);
  702.  
  703. } /* end of ml_write */
  704.  
  705. /* ml_writei : (int * bytearray * int * int) -> unit
  706.  * Write data from the given bytearray to the specified file, starting at the
  707.  * given offset.  This routine is guaranteed to write all the bytes.
  708.  */
  709. void ml_writei (msp, arg)
  710.     MLState_ptr     msp;
  711.     register ML_val_t arg;
  712. {
  713.     int            sts;
  714.  
  715.     sts = write_all (
  716.         REC_SELINT(arg, 0),
  717.         (char *)REC_SELPTR(arg, 1) + REC_SELINT(arg, 2),
  718.         REC_SELINT(arg, 3));
  719.  
  720.     if (sts == -1)
  721.     raise_syserror(msp, 0);
  722.     else
  723.     RETURN(msp, ML_unit);
  724.  
  725. } /* end of ml_writei */
  726.  
  727.  
  728. #ifndef HAS_WRITEV
  729. struct iovec {
  730.     char        *iov_base;
  731.     int            iov_len;
  732. };
  733. #endif /* [e] !HAS_WRITEV */
  734.  
  735. /* write_multiple:
  736.  * Write a vector of blocks and return the number of blocks written.  Normally,
  737.  * this will be iovcnt, but if a signal occurs during the write, then it can
  738.  * be less.  Return -1 on error.
  739.  */
  740. static int write_multiple (msp, fd, iov, iovcnt, nbytes)
  741.     MLState_ptr     msp;
  742.     int            fd;
  743.     struct iovec    *iov;
  744.     int            iovcnt, nbytes;
  745. {
  746. #ifdef HAS_WRITEV
  747.     int            skip = 0, i = iovcnt;
  748.  
  749.     while (nbytes > 0) {
  750.       advance:;
  751.     while (skip > 0) {
  752.         if (iov->iov_len <= skip)
  753.         skip -= iov->iov_len;
  754.         else {
  755.           /* write the incomplete buffer */
  756.         int    sts;
  757.         do {
  758.             sts = write_all(fd, iov->iov_base+skip, iov->iov_len-skip);
  759.             if (sts < 0) {
  760.             raise_syserror(msp, 0);
  761.             return -1;
  762.             }
  763.         } while (sts != 0);
  764.         if ((nbytes -= (iov->iov_len - skip)) == 0)
  765.             return iovcnt;
  766.         else if (msp->NumPendingSigs > 0)
  767.             return ((iovcnt - i) + 1);
  768.         }
  769.         i--;  iov++;
  770.     }
  771.     DO_SYSCALL (writev(fd, iov, i), skip);
  772.     if (skip < 0) {
  773.         raise_syserror(msp, 0);
  774.         return -1;
  775.     }
  776.     nbytes -= skip;
  777.     }
  778. #else /* [e] !HAS_WRITEV */
  779.     int            i, sts;
  780.  
  781.     for (i = 0;  i < iovcnt;  i++) {
  782. /*    if ((sts = write_all (fd, vec[i].iov_base, vec[i].iov_len)) == -1)  wrong?! 02Jan92  e  */
  783.     if ((sts = write_all (fd, iov[i].iov_base, iov[i].iov_len)) == -1)
  784.         return -1;
  785.     else
  786.         i++;
  787.     if (msp->NumPendingSigs > 0)
  788.         return i;
  789.     }
  790. #endif HAS_WRITEV
  791.  
  792.     return iovcnt;
  793.  
  794. } /* end of write_multiple */
  795.  
  796. #define WRITEVEC_SZ    8
  797.  
  798. /* ml_writev : (int * (bytearray * int) list) -> unit
  799.  * For each (data, len) element in the list, write the len number of bytes to the
  800.  * file descriptor.
  801.  */
  802. void ml_writev (msp, arg)
  803.     MLState_ptr     msp;
  804.     ML_val_t        arg;
  805. {
  806.     int            fd = REC_SELINT(arg, 0);
  807.     ML_val_t        p = REC_SEL(arg, 1), q = p;
  808.     int            nbytes = 0, i, n;
  809.     struct iovec    vec[WRITEVEC_SZ];
  810.  
  811.     nbytes = 0;
  812.     for (i = 0; p != ML_nil;  ) {
  813.     ML_val_t    pair = ML_hd(p);
  814.  
  815.     p = ML_tl(p);
  816.     vec[i].iov_base = (char *)REC_SELPTR(pair, 0);
  817.     vec[i].iov_len  = REC_SELINT(pair, 1);
  818.     nbytes += vec[i].iov_len;
  819.     if ((++i == WRITEVEC_SZ) || (p == ML_nil)) {
  820.         if ((n = write_multiple(msp, fd, vec, i, nbytes)) < 0)
  821.         return; /* error */
  822.         else if (n < i) {
  823.           /* a signal occurred, so set things up so that the resume continuation
  824.            * will complete the write operation.
  825.            */
  826.         while (n > 0) {
  827.             q = ML_tl(q);  n--;
  828.         }
  829.         REC_ALLOC2 (msp, arg, INT_CtoML(fd), q);
  830.         REC_ALLOC2 (msp, msp->ml_arg, PTR_CtoML(ml_writev), arg);
  831.         msp->ml_closure = PTR_CtoML(callc_v+1);
  832.         msp->ml_pc        = CODE_ADDR(PTR_CtoML(callc_v+1));
  833.         return;
  834.         }
  835.         nbytes = 0;
  836.         i = 0;
  837.         q = p;
  838.     }
  839.     } /* end of for */
  840.  
  841. } /* end of ml_writev */
  842.  
  843. /* ml_lseek : (int * int * int) -> int
  844.  */
  845. void ml_lseek (msp, arg)
  846.     MLState_ptr        msp;
  847.     ML_val_t        arg;
  848. {
  849.     int        fd = REC_SELINT(arg, 0);
  850. #ifdef THINK_C
  851.     long    offset = REC_SELINT(arg, 1), pos;
  852. #else
  853.     off_t    offset = REC_SELINT(arg, 1), pos;
  854. #endif
  855.     int        whence = REC_SELINT(arg, 2);
  856.  
  857.     DO_SYSCALL(lseek(fd, offset, whence), pos);
  858.     CHK_RETURN(msp, pos);
  859.  
  860. } /* end of ml_lseek */
  861.  
  862. /* ml_send_obd : (fd * bytearray * int) -> unit
  863.  * Send out-of-band data on the specified socket file descriptor.
  864.  */
  865. void ml_send_obd (msp, arg)
  866.     MLState_ptr     msp;
  867.     ML_val_t        arg;
  868. {
  869. #ifdef THINK_C
  870.     /* Mac does not have sockets */
  871.     raise_ThinkC_error(msp);
  872. #else
  873.     int            fd = REC_SELINT(arg, 0);
  874.     char        *buf = (char *)REC_SELPTR(arg, 1);
  875.     register int    nbytes = REC_SELINT(arg, 2);
  876.     register int    n;
  877.  
  878.     while (nbytes > 0) {
  879.     DO_SYSCALL (send (fd, buf, nbytes, MSG_OOB), n);
  880.     if (n > 0) {
  881.         nbytes -= n;
  882.         buf += n;
  883.     }
  884.     else
  885.         raise_syserror (msp, 0);
  886.     }
  887. #endif
  888. } /* end of ml_send_obd */
  889.  
  890.  
  891. /* ml_getdirent : int -> string list
  892.  * Get directory entries from the directory referenced by fdesc.  If there are
  893.  * no more entries, then return nil.
  894.  */
  895. static void ml_getdirent (msp, arg)
  896.     MLState_ptr     msp;
  897.     ML_val_t        arg;
  898. {
  899. #ifdef THINK_C
  900.     /* Mac version not done yet */
  901.     raise_ThinkC_error(msp);
  902. #else
  903.     int            fd = INT_MLtoC(arg);
  904.     char        buf[DIRBLKSIZ];
  905.     register int    nbytes, i;
  906.     ML_val_t        l = ML_nil;
  907.  
  908.     do {
  909.     
  910.     DO_SYSCALL (READDIR(fd, buf, DIRBLKSIZ), nbytes); 
  911.     if (nbytes == -1) {
  912.         raise_syserror (msp, 0);
  913.         return;
  914.     }
  915.     else {
  916.         ML_val_t        s;
  917.         DIR_ENTRY_TY    *dp;
  918.  
  919.         for (i = 0;  i < nbytes;  i += dp->d_reclen) {
  920.         dp = (DIR_ENTRY_TY *)&(buf[i]);
  921.         if (dp->d_name[0] != 0) {
  922.             s = ML_alloc_string (msp, dp->d_name);
  923.             l = ML_cons (msp, s, l);
  924.         }
  925.         } /* end of for */
  926.     }
  927.     } while ((nbytes > 0) && (l == ML_nil));
  928.     RETURN(msp, l);
  929. #endif
  930. } /* end of ml_getdirent */
  931.  
  932.  
  933. /* ml_chdir : string -> unit
  934.  */
  935. void ml_chdir (msp, arg)
  936.     MLState_ptr        msp;
  937.     ML_val_t        arg;
  938. {
  939.     int        sts;
  940.  
  941.     DO_SYSCALL(chdir((char *)PTR_MLtoC(arg)), sts);
  942.     CHK_RETURN_UNIT(msp, sts);
  943.  
  944. } /* end of ml_chdir */
  945.  
  946. /* ml_mkdir : (string * int) -> unit
  947.  */
  948. void ml_mkdir (msp, arg)
  949.     MLState_ptr        msp;
  950.     ML_val_t        arg;
  951. {
  952. #ifdef THINK_C
  953.     /* Mac version not done yet */
  954.     raise_ThinkC_error(msp);
  955. #else
  956.     char    *path = (char *)REC_SELPTR(arg, 0);
  957.     int        mode = REC_SELINT(arg, 1);
  958.     int        sts;
  959.  
  960.     DO_SYSCALL(mkdir(path, mode), sts);
  961.     CHK_RETURN_UNIT(msp, sts);
  962. #endif
  963. } /* end of ml_mkdir */
  964.  
  965. /* ml_readlink : string -> string
  966.  * Read the contents of the specified symbolic link.
  967.  */
  968. void ml_readlink (msp, arg)
  969.     MLState_ptr     msp;
  970.     ML_val_t        arg;
  971. {
  972. #ifdef THINK_C
  973.     /* Mac version not done yet */
  974.     raise_ThinkC_error(msp);
  975. #else
  976.     char        *lname = (char *)PTR_MLtoC(arg);
  977.     int            n;
  978.     char        buf[MAXPATHLEN];
  979.  
  980.     if ((n = readlink(lname, buf, MAXPATHLEN)) == -1)
  981.     raise_syserror (msp, 0);
  982.     else {
  983.     ML_val_t    path;
  984.     buf[n] = '\0';
  985.     path = ML_alloc_string (msp, buf);
  986.     RETURN(msp, path);
  987.     }
  988. #endif
  989. } /* end of ml_readlink */
  990.  
  991.  
  992. /* ml_truncate : (fd or string * int) -> unit
  993.  * Truncate the specified file to the specified length.
  994.  */
  995. void ml_truncate (msp, arg)
  996.     MLState_ptr     msp;
  997.     ML_val_t        arg;
  998. {
  999. #ifdef THINK_C
  1000.     /* Mac version not done yet */
  1001.     raise_ThinkC_error(msp);
  1002. #else
  1003.     register ML_val_t f = REC_SEL(arg, 0);
  1004.     int            len = REC_SELINT(arg, 1);
  1005.     int            sts;
  1006.  
  1007.     if (OBJ_isBOXED(f))
  1008.     sts = truncate(PTR_MLtoC(f), len);
  1009.     else
  1010.     sts = ftruncate(INT_MLtoC(f), len);
  1011.  
  1012.     CHK_RETURN(msp, sts);
  1013. #endif
  1014. } /* end of ml_truncate */
  1015.  
  1016. /* ml_umask : int -> int
  1017.  */
  1018. void ml_umask (msp, arg)
  1019.     MLState_ptr        msp;
  1020.     ML_val_t        arg;
  1021. {
  1022. #ifdef THINK_C
  1023.     /* Mac version not done yet */
  1024.     raise_ThinkC_error(msp);
  1025. #else
  1026.     int        oldMask;
  1027.  
  1028.     DO_SYSCALL(umask(INT_MLtoC(arg)), oldMask);
  1029.     CHK_RETURN(msp, oldMask);
  1030. #endif
  1031. } /* end of ml_umask */
  1032.  
  1033. /* ml_chmod : (fd or string * int) -> unit
  1034.  * Change the protection mode of the specified file.
  1035.  */
  1036. void ml_chmod (msp, arg)
  1037.     MLState_ptr     msp;
  1038.     ML_val_t        arg;
  1039. {
  1040. #ifdef THINK_C
  1041.     /* Mac has no access protection */
  1042.     RETURN(msp, 0)
  1043. #else
  1044.     ML_val_t        f = REC_SEL(arg, 0);
  1045.     int            mode = REC_SELINT(arg, 1);
  1046.     int            sts;
  1047.  
  1048.     if (OBJ_isBOXED(f))
  1049.     sts = chmod((char *)PTR_MLtoC(f), mode);
  1050.     else
  1051.     sts = fchmod(INT_MLtoC(f), mode);
  1052.  
  1053.     CHK_RETURN(msp, sts);
  1054. #endif
  1055. } /* end of ml_chmod */
  1056.  
  1057.  
  1058. /* ml_access : (string * int list) -> bool
  1059.  * Check to see if the user has the specified access to the specified file.
  1060.  * NOTE: In the long run, there should be a datatype for the return value
  1061.  * of access, since it can fail for significantly different reasons
  1062.  * (e.g., no such file, not a directory, looping path, ...). -- JHR
  1063.  */
  1064. void ml_access (msp, arg)
  1065.     MLState_ptr     msp;
  1066.     ML_val_t        arg;
  1067. {
  1068. #ifdef THINK_C
  1069.     /* Mac has no access protection */
  1070.     RETURN(msp, ML_true)
  1071. #else
  1072.     char        *path = (char *)REC_SELPTR(arg, 0);
  1073.     register ML_val_t p = REC_SEL(arg, 1);
  1074.     int            mode = F_OK;
  1075.  
  1076.     for (;  p != ML_nil;  p = ML_tl(p)) {
  1077.         switch (INT_MLtoC(ML_hd(p))) {
  1078.       case 0: mode |= R_OK; break;
  1079.       case 1: mode |= W_OK; break;
  1080.       case 2: mode |= X_OK; break;
  1081.       default:
  1082.         raise_syserror (msp, "unknown access mode");
  1083.         return;
  1084.     } /* end of switch */
  1085.     } /* end of for */
  1086.  
  1087.     if (access(path, mode) == 0)
  1088.     RETURN(msp, ML_true)
  1089.     else
  1090.     RETURN(msp, ML_false)
  1091. #endif
  1092. } /* end of ml_access. */
  1093.  
  1094. #ifdef THINK_C
  1095. struct stat {
  1096.     int foo;
  1097. };
  1098. static int ___lstat (char *s, struct stat *buf)
  1099.     {
  1100. }
  1101. static int ____fstat (int fd,  struct stat *buf)
  1102.     {
  1103. }
  1104. #endif
  1105. #ifndef THINK_C
  1106. /* stat_file:
  1107.  * Get the file status of f.  The file can either be specified as a path, in which
  1108.  * case f will be a boxed ML string, otherwise f will be an unboxed file descriptor.
  1109.  */
  1110. static int stat_file (msp, f, buf)
  1111.     MLState_ptr     msp;
  1112.     ML_val_t        f;
  1113.     struct stat        *buf;
  1114. {
  1115.     int            sts;
  1116.  
  1117.     if (OBJ_isBOXED(f))
  1118.     sts = lstat((char *)PTR_MLtoC(f), buf);
  1119.     else
  1120.     sts = fstat(INT_MLtoC(f), buf);
  1121.  
  1122.     if (sts == -1)
  1123.     raise_syserror (msp, 0);
  1124.  
  1125.     return sts;
  1126.  
  1127. } /* end of stat_file */
  1128. #endif
  1129.  
  1130. /* ml_getfid : (fd or string) -> fileid
  1131.  * Return the unique file id (a string created from the device and inode of the
  1132.  * file) of the specified file.
  1133.  */
  1134. void ml_getfid (msp, f)
  1135.     MLState_ptr     msp;
  1136.     ML_val_t        f;
  1137. {
  1138. #ifdef THINK_C
  1139.     /* Mac version not done yet */
  1140.     raise_ThinkC_error(msp);
  1141. #else
  1142.     struct stat        buf;
  1143.     struct { dev_t dev; ino_t ino; } id_buf;
  1144.     ML_val_t        p;
  1145.  
  1146.     if (stat_file(msp, f, &buf) == 0) {
  1147.     register int    sz = (sizeof(id_buf)+3) & ~3;
  1148.  
  1149.     ML_alloc_write (msp, 0, MAKE_DESC(sz, TAG_string));
  1150.     p = ML_alloc (msp, sz >> 2);
  1151.  
  1152.     bzero ((char *)&id_buf, sz);
  1153.     id_buf.dev = buf.st_dev;
  1154.     id_buf.ino = buf.st_ino;
  1155.     bcopy ((char *)&id_buf, (char *)PTR_MLtoC(p), sz);
  1156.  
  1157.     RETURN(msp, p);
  1158.     }
  1159. #endif
  1160. } /* end of ml_getfid */
  1161.  
  1162. /* ml_getmod : (fd or string) -> int
  1163.  * Return the file protection mode of the file specified by f.
  1164.  */
  1165. void ml_getmod (msp, f)
  1166.     MLState_ptr     msp;
  1167.     ML_val_t        f;
  1168. {
  1169. #ifdef THINK_C
  1170.     /* Mac has no access protection. */
  1171.     RETURN(msp, INT_CtoML(0777));
  1172. #else
  1173.     struct stat        buf;
  1174.  
  1175.     if (stat_file(msp, f, &buf) == 0) {
  1176.     RETURN(msp, INT_CtoML(buf.st_mode & 0777));
  1177.     }
  1178. #endif
  1179. } /* end of ml_getmod */
  1180.  
  1181. /* ml_ftype : (fd or string) -> int
  1182.  * Return the file type of the file specified by f.  The return values must
  1183.  * track those in System.Unsafe.FileIO (see "boot/perv.sml").
  1184.  */
  1185. void ml_ftype (msp, f)
  1186.     MLState_ptr     msp;
  1187.     ML_val_t        f;
  1188. {
  1189. #ifdef THINK_C
  1190.     /* Mac version not done yet */
  1191.     raise_ThinkC_error(msp);
  1192. #else
  1193.     struct stat        buf;
  1194.     register ML_val_t typ;
  1195.  
  1196.     if (stat_file(msp, f, &buf) == 0) {
  1197.     switch (buf.st_mode & S_IFMT) {
  1198.       case S_IFREG: typ = INT_CtoML(0); break;
  1199.       case S_IFDIR: typ = INT_CtoML(1); break;
  1200.       case S_IFLNK: typ = INT_CtoML(2); break;
  1201.       case S_IFSOCK: typ = INT_CtoML(3); break;
  1202.       case S_IFCHR: typ = INT_CtoML(4); break;
  1203.       case S_IFBLK: typ = INT_CtoML(5); break;
  1204.       default:
  1205.         raise_syserror(msp, "unknown file type");
  1206.         return;
  1207.     }
  1208.     RETURN(msp, typ);
  1209.     }
  1210. #endif
  1211. } /* end of ml_ftype */
  1212.  
  1213. /* ml_getownid : (fd or string) -> (int * int)
  1214.  * Return the user and group ids of the specified file.
  1215.  */
  1216. void ml_getownid (msp, f)
  1217.     MLState_ptr     msp;
  1218.     ML_val_t        f;
  1219. {
  1220. #ifdef THINK_C
  1221.     /* Mac has no file owners. */
  1222.     ML_val_t        obj;
  1223.     REC_ALLOC2 (msp, obj, INT_CtoML(0), INT_CtoML(0));
  1224.     RETURN(msp, obj);
  1225. #else
  1226.     struct stat        buf;
  1227.     ML_val_t        obj;
  1228.  
  1229.     if (stat_file(msp, f, &buf) == 0) {
  1230.     REC_ALLOC2 (msp, obj, INT_CtoML(buf.st_uid), INT_CtoML(buf.st_gid));
  1231.     RETURN(msp, obj);
  1232.     }
  1233. #endif
  1234. } /* end of ml_getownid */
  1235.  
  1236. /* ml_fsize : (fd or string) -> int
  1237.  * Return the size in bytes of the specified file.
  1238.  */
  1239. void ml_fsize (msp, f)
  1240.     MLState_ptr     msp;
  1241.     ML_val_t        f;
  1242. {
  1243. #ifdef THINK_C
  1244.     /* Mac has no stat. */
  1245.     int    pos, len, fd;
  1246.     extern int        overflow_e0[];
  1247.  
  1248.     if (OBJ_isBOXED(f))    {
  1249.         fd = open((char *)PTR_MLtoC(f), O_RDONLY);
  1250.         if (fd < 0)    {
  1251.         raise_syserror (msp, 0);
  1252.         return;
  1253.     }
  1254.     len = lseek(fd, 0L, SEEK_END);
  1255.     close(fd);
  1256.     }
  1257.     else {
  1258.         fd = INT_MLtoC(f);
  1259.     pos = tell(fd);                /* get current position */
  1260.     if(pos == EOF)
  1261.         len = pos;                /* error */
  1262.     else    {
  1263.         len = lseek(fd, 0, SEEK_END);    /* get file size (inefficiently) */
  1264.         pos = lseek(fd, pos, SEEK_SET);    /* recover position */
  1265.     }
  1266.     }
  1267.     /* get the file length */
  1268.     if (len == EOF)
  1269.     raise_syserror (msp, 0);
  1270.     else    {
  1271.     if ((len & 0xC0000000) != 0) {
  1272.         msp->fault_exn = PTR_CtoML(overflow_e0+1);
  1273.         raise_ml_exn (msp);
  1274.     }
  1275.     else
  1276.         RETURN(msp, INT_CtoML(len))
  1277.     }
  1278. #else
  1279.     struct stat        buf;
  1280.     extern int        overflow_e0[];
  1281.  
  1282.     if (stat_file(msp, f, &buf) == 0) {
  1283.     if ((buf.st_size & 0xC0000000) != 0) {
  1284.         msp->fault_exn = PTR_CtoML(overflow_e0+1);
  1285.         raise_ml_exn (msp);
  1286.     }
  1287.     else
  1288.         RETURN(msp, INT_CtoML(buf.st_size))
  1289.     }
  1290. #endif
  1291. } /* end of ml_fsize */
  1292.  
  1293. /* ml_atime : (fd or string) -> (int * int)
  1294.  * Get the most recent access time of the specified file.
  1295.  */
  1296. void ml_atime (msp, f)
  1297.     MLState_ptr     msp;
  1298.     ML_val_t        f;
  1299. {
  1300. #ifdef THINK_C
  1301.     /* Mac version not done yet */
  1302.     raise_ThinkC_error(msp);
  1303. #else
  1304.     struct stat        buf;
  1305.  
  1306.     if (stat_file(msp, f, &buf) == 0) {
  1307.     ML_val_t    obj;
  1308.     REC_ALLOC2 (msp, obj, INT_CtoML(buf.st_atime), INT_CtoML(0));
  1309.     RETURN(msp, obj);
  1310.     }
  1311. #endif
  1312. } /* end of ml_atime */
  1313.  
  1314. /* ml_ctime : (fd or string) -> (int * int)
  1315.  * Get the creation time of the specified file.
  1316.  */
  1317. void ml_ctime (msp, f)
  1318.     MLState_ptr     msp;
  1319.     ML_val_t        f;
  1320. {
  1321. #ifdef THINK_C
  1322.     /* Mac version not done yet */
  1323.     raise_ThinkC_error(msp);
  1324. #else
  1325.     struct stat        buf;
  1326.     extern int        overflow_e0[];
  1327.  
  1328.     if (stat_file(msp, f, &buf) == 0) {
  1329.     ML_val_t    obj;
  1330.     REC_ALLOC2 (msp, obj, INT_CtoML(buf.st_ctime), INT_CtoML(0));
  1331.     RETURN(msp, obj);
  1332.     }
  1333. #endif
  1334. } /* end of ml_ctime */
  1335.  
  1336. /* ml_mtime : (fd or string) -> (int * int)
  1337.  * Get the most recent modification time of the specified file.
  1338.  */
  1339. void ml_mtime (msp, f)
  1340.     MLState_ptr     msp;
  1341.     ML_val_t        f;
  1342. {
  1343. #ifdef THINK_C
  1344.     /* Mac version not done yet */
  1345.     raise_ThinkC_error(msp);
  1346. #else
  1347.     struct stat        buf;
  1348.     extern int        overflow_e0[];
  1349.  
  1350.     if (stat_file(msp, f, &buf) == 0) {
  1351.     ML_val_t    obj;
  1352.     REC_ALLOC2 (msp, obj, INT_CtoML(buf.st_mtime), INT_CtoML(0));
  1353.     RETURN(msp, obj);
  1354.     }
  1355. #endif
  1356. } /* end of ml_mtime */
  1357.  
  1358.  
  1359. /* ml_isatty : int -> bool
  1360.  * Return true if the file descriptor fd refers to a tty device.
  1361.  */
  1362. void ml_isatty (msp, fd)
  1363.     MLState_ptr     msp;
  1364.     ML_val_t        fd;
  1365. {
  1366.     RETURN(msp, isatty(INT_MLtoC(fd)) ? ML_true : ML_false);
  1367.  
  1368. } /* end of ml_isatty */
  1369.  
  1370.  
  1371. #ifndef THINK_C
  1372. /* fd_list2set:
  1373.  * Map a ML list of file descriptors to a fd_set.
  1374.  */
  1375. static fd_set *fd_list2set (fdl, fds, width)
  1376.     ML_val_t        fdl;
  1377.     fd_set        *fds;
  1378.     int            *width;
  1379. {
  1380.     register int    fd, maxfd = -1;
  1381.  
  1382.     FD_ZERO(fds);
  1383.     while (fdl != ML_nil) {
  1384.     fd = INT_MLtoC(ML_hd(fdl));
  1385.     if (fd > maxfd)
  1386.         maxfd = fd;
  1387.     FD_SET (fd, fds);
  1388.     fdl = ML_tl(fdl);
  1389.     }
  1390.  
  1391.     if (maxfd >= 0) {
  1392.     if (maxfd >= *width)
  1393.         *width = maxfd+1;
  1394.     return fds;
  1395.     }
  1396.     else
  1397.     return (fd_set *)0;
  1398. }
  1399. #endif
  1400.  
  1401. #ifndef THINK_C
  1402. /* fd_set2list:
  1403.  * Map a fd_set to a ML list of ready file descriptors.
  1404.  */
  1405. static ML_val_t fd_set2list (msp, fds, width)
  1406.     MLState_ptr     msp;
  1407.     register fd_set *fds;
  1408.     register int    width;
  1409. {
  1410.     register ML_val_t p;
  1411.     register int    i;
  1412.  
  1413.     if (fds == 0)
  1414.     return ML_nil;
  1415.  
  1416.     for (i = 0, p = ML_nil;  i < width;  i++) {
  1417.     if (FD_ISSET(i, fds))
  1418.         p = ML_cons (msp, INT_CtoML(i), p);
  1419.     }
  1420.  
  1421.     return p;
  1422. }
  1423. #endif
  1424.  
  1425. /* ml_select : (int list * int list * int list * (int * int))
  1426.  *                 -> (int list * int list * int list)
  1427.  * Check file descriptors for the readiness of I/O operations.
  1428.  */
  1429. void ml_select (msp, arg)
  1430.     MLState_ptr     msp;
  1431.     ML_val_t        arg;
  1432. {
  1433. #ifdef THINK_C
  1434.     /* Mac version not done yet */
  1435.     raise_ThinkC_error(msp);
  1436. #else
  1437.     ML_val_t        rl = REC_SEL(arg, 0);
  1438.     ML_val_t        wl = REC_SEL(arg, 1);
  1439.     ML_val_t        el = REC_SEL(arg, 2);
  1440.     ML_val_t        timeout = REC_SEL(arg, 3);
  1441.     fd_set        rset, wset, eset;
  1442.     fd_set        *rfds, *wfds, *efds;
  1443.     int            width = 0, sts;
  1444.     struct timeval  t, *tp;
  1445.  
  1446.     rfds = fd_list2set (rl, &rset, &width);
  1447.     wfds = fd_list2set (wl, &wset, &width);
  1448.     efds = fd_list2set (el, &eset, &width);
  1449.  
  1450.     if (OBJ_isBOXED(timeout)) {
  1451.     t.tv_sec = REC_SELINT(timeout, 0);
  1452.     t.tv_usec = REC_SELINT(timeout, 1);
  1453.     tp = &t;
  1454.     }
  1455.     else
  1456.     tp = 0;
  1457.  
  1458.     if (msp->inSigHandler || msp->maskSignals
  1459.     || ((! _setjmp (msp->SysCallEnv)) && 
  1460.     (((msp->ioWaitFlag = 1), (msp->NumPendingSigs == 0))))) {
  1461. #ifdef RISCos
  1462.     /* problem with select and pipes */
  1463.     sts = 0;
  1464. #else
  1465.     DO_SYSCALL (select (width, rfds, wfds, efds, tp), sts);
  1466. #endif
  1467.     msp->ioWaitFlag = 0;
  1468.     }
  1469.     else {
  1470.     backup_kont(msp);
  1471.     sigsetmask (0);  /* re-enable signals */
  1472.     return;
  1473.     }
  1474.  
  1475.     if (sts == -1)
  1476.     raise_syserror (msp, 0);
  1477.     else {
  1478.     ML_val_t        rfdl, wfdl, efdl, res;
  1479.  
  1480.     if (sts == 0)
  1481.         rfdl = wfdl = efdl = ML_nil;
  1482.     else {
  1483.         rfdl = fd_set2list (msp, rfds, width);
  1484.         wfdl = fd_set2list (msp, wfds, width);
  1485.         efdl = fd_set2list (msp, efds, width);
  1486.     }
  1487.     REC_ALLOC3 (msp, res, rfdl, wfdl, efdl);
  1488.     RETURN(msp, res);
  1489.     }
  1490. #endif
  1491. } /* end of ml_select */
  1492.  
  1493.  
  1494. /* ml_pipe : unit -> (int * int)
  1495.  * Create a pipe and return its input and output descriptors.
  1496.  */
  1497. void ml_pipe (msp)
  1498.     MLState_ptr     msp;
  1499. {
  1500. #ifdef THINK_C
  1501.     /* Mac version not done yet */
  1502.     raise_ThinkC_error(msp);
  1503. #else
  1504.     int        fds[2];
  1505.  
  1506.     if (pipe(fds) == -1)
  1507.     raise_syserror (msp, 0);
  1508.     else {
  1509.     ML_val_t obj;
  1510.     REC_ALLOC2 (msp, obj, INT_CtoML(fds[0]), INT_CtoML(fds[1]));
  1511.     RETURN(msp, obj);
  1512.     }
  1513. #endif
  1514. } /* end of ml_pipe. */
  1515.  
  1516.  
  1517. /* ml_fionread : int -> int
  1518.  * Return the number of bytes available for reading in the given file.
  1519.  */
  1520. void ml_fionread (msp, arg)
  1521.      MLState_ptr     msp;
  1522.     int        arg;
  1523. {
  1524. #ifdef THINK_C
  1525.     int        fd = INT_MLtoC(arg);
  1526.     int        sz;
  1527.     
  1528.     sz = fionread(fd);
  1529.     if (sz < 0)
  1530.     raise_syserror (msp, 0);
  1531.     else
  1532.     RETURN(msp, INT_CtoML(sz));
  1533. #else
  1534.     int        fd = INT_MLtoC(arg);
  1535.     struct stat    buf;
  1536.     int        pos;
  1537.     int        count[2], r;
  1538.  
  1539. #  ifdef HPUX
  1540.     if (isatty(fd)) {        /* FIONREAD unsupported on tty's on 6.5 */
  1541.     fd_set        readfds;
  1542.     int        nfound;
  1543.     struct timeval    timeout;
  1544.  
  1545.     FD_SET(fd, &readfds);
  1546.     timeout.tv_sec = 0;  timeout.tv_usec = 0;
  1547.     nfound = select(fd+1, &readfds, 0, 0, &timeout);
  1548.     CHK_RETURN(msp, nfound);
  1549.     } /* if */
  1550. #  else
  1551.     if (ioctl(fd, FIONREAD, count) >= 0)
  1552.     RETURN(msp, INT_CtoML(count[0]));
  1553. #  endif HPUX
  1554.  
  1555.     if ((fstat(fd, &buf) < 0) || ((pos = lseek(fd, 0, L_INCR)) < 0))
  1556.     raise_syserror (msp, 0);
  1557.     else
  1558.     RETURN(msp, INT_CtoML(buf.st_size - pos));
  1559. #endif
  1560. } /* end of ml_fionread */
  1561.  
  1562.  
  1563. /* ml_system : string -> int
  1564.  * Issue the given shell command and return the exit status.
  1565.  */
  1566. void ml_system (msp, arg)
  1567.     MLState_ptr     msp;
  1568.     ML_val_t    arg;
  1569. {
  1570.     int        sts;
  1571.  
  1572.     sts = system ((char *)PTR_MLtoC(arg));
  1573.     CHK_RETURN (msp, sts);
  1574.  
  1575. } /* end of ml_system */
  1576.  
  1577.  
  1578. /* ml_exec : (string * string list * string list) -> (int * int)
  1579.  * Fork a process to execute the given command, with the given command-line
  1580.  * arguments and environment.  Return the file descriptors for pipes
  1581.  * connected to the process' stdin and stdout. The arg list should be
  1582.  * non-empty with the command name as the first element.
  1583.  */
  1584. void ml_exec (msp, arg)
  1585.     MLState_ptr     msp;
  1586.     ML_val_t        arg;
  1587. {
  1588. #ifdef THINK_C
  1589.     /* Mac version not done yet */
  1590.     raise_ThinkC_error(msp);
  1591. #else
  1592.     char        *cmd = (char *)REC_SELPTR(arg, 0);
  1593.     ML_val_t        arglst = REC_SEL(arg, 1);
  1594.     ML_val_t        envlst = REC_SEL(arg, 2);
  1595.     int            p1[2], p2[2];
  1596.     ML_val_t        res;
  1597.  
  1598.   /* reap any dead child processes (this is to avoid overflowing the
  1599.    * process table with zombies).
  1600.    */
  1601. #if (defined(RISCos) || defined(NeXT) || defined(DYNIX) || defined(MACH) || defined(sony_news))
  1602.    /* Some vendors don't know about POSIX */
  1603.     {
  1604.     union wait status;
  1605.     while (wait3 (&status, WNOHANG, 0) > 0)
  1606.         continue;
  1607.     }
  1608. #else
  1609.     while (waitpid (-1, 0, WNOHANG) > 0)
  1610.     continue;
  1611. #endif
  1612.  
  1613.     if ((pipe(p1) < 0) || (pipe(p2) < 0))
  1614.     raise_syserror (msp, 0);
  1615. #if defined(V9) || defined(SGI) || defined(AUX)
  1616.     else if (fork()) {
  1617. #else
  1618.     else if (vfork()) {
  1619. #endif
  1620.     close(p1[0]); close(p2[1]);
  1621.     REC_ALLOC2 (msp, res, INT_CtoML(p2[0]), INT_CtoML(p1[1]));
  1622.     RETURN(msp, res);
  1623.     }
  1624.     else {
  1625.     char        **argv, **envp;
  1626.     register ML_val_t p;
  1627.     register char   **cp;
  1628.  
  1629.       /* use the heap for temp space for the argv[] and envp[] vectors */
  1630.     argv = cp = (char **)(msp->ml_allocptr);
  1631.     for (p = arglst;  p != ML_nil;  p = ML_tl(p))
  1632.         *cp++ = (char *)PTR_MLtoC(ML_hd(p));
  1633.     *cp++ = 0;  /* terminate the argv[] */
  1634.     envp = cp;
  1635.     for (p = envlst;  p != ML_nil;  p = ML_tl(p))
  1636.         *cp++ = (char *)PTR_MLtoC(ML_hd(p));
  1637.     *cp++ = 0;  /* terminate the envp[] */
  1638.  
  1639.     close (p1[1]); close (p2[0]);
  1640.     dup2 (p1[0], 0); dup2 (p2[1], 1);
  1641.     execve(cmd, argv, envp);
  1642.     _exit(1);
  1643.     }
  1644. #endif
  1645. } /* end of ml_exec */
  1646.  
  1647. /* ml_exit : int -> 'a
  1648.  */
  1649. void ml_exit (msp, arg)
  1650.     MLState_ptr        msp;
  1651.     ML_val_t        arg;
  1652. {
  1653.     mp_shutdown (msp, INT_MLtoC(arg));
  1654.  
  1655. } /* end of ml_exit */
  1656.  
  1657. extern ML_val_t make_str_list();
  1658.  
  1659. /* ml_argv : unit -> string list
  1660.  * Return the command-line argument list.
  1661.  */
  1662. void ml_argv (msp)
  1663.     MLState_ptr     msp;
  1664. {
  1665.     extern char **global_argv;
  1666.  
  1667.     RETURN(msp, make_str_list (msp, global_argv));
  1668.  
  1669. } /* end of ml_argv */
  1670.  
  1671. /* ml_envrion : unit -> string list
  1672.  * Return the environment list.
  1673.  */
  1674. void ml_environ (msp)
  1675.     MLState_ptr     msp;
  1676. {
  1677. #ifdef THINK_C
  1678.     /* Dummy Mac version */
  1679.     RETURN(msp, ML_nil);
  1680. #else
  1681.     extern char **environ;
  1682.  
  1683.     RETURN(msp, make_str_list (msp, environ));
  1684. #endif
  1685. } /* end of ml_environ */
  1686.  
  1687. /* ml_getpid : unit -> int
  1688.  */
  1689. void ml_getpid (msp, arg)
  1690.     MLState_ptr        msp;
  1691.     ML_val_t        arg;
  1692. {
  1693.     RETURN (msp, INT_CtoML(getpid()));
  1694.  
  1695. } /* end of ml_getpid */
  1696.  
  1697. /* ml_getuid : unit -> int
  1698.  */
  1699. void ml_getuid (msp, arg)
  1700.     MLState_ptr        msp;
  1701.     ML_val_t        arg;
  1702. {
  1703.     RETURN (msp, INT_CtoML(getuid()));
  1704.  
  1705. } /* end of ml_getuid */
  1706.  
  1707. /* ml_getgid : unit -> int
  1708.  */
  1709. void ml_getgid (msp, arg)
  1710.     MLState_ptr        msp;
  1711.     ML_val_t        arg;
  1712. {
  1713.     RETURN (msp, INT_CtoML(getgid()));
  1714.  
  1715. } /* end of ml_getgid */
  1716.  
  1717. /* ml_gethostname : unit -> string
  1718.  * Return the name of our host.
  1719.  */
  1720. void ml_gethostname (msp)
  1721.     MLState_ptr     msp;
  1722. {
  1723. #ifdef THINK_C
  1724.     /* Mac version not done yet */
  1725.     ML_val_t name;
  1726.     name = ML_alloc_string (msp, "Mac");
  1727.     RETURN(msp, name);
  1728. #else
  1729.     char    buf[64];
  1730.  
  1731.     if (gethostname(buf, 64) == 0) {
  1732.     ML_val_t name;
  1733.     buf[63] = '\0';  /* insure null termination */
  1734.     name = ML_alloc_string (msp, buf);
  1735.     RETURN(msp, name);
  1736.     }
  1737.     else
  1738.     raise_syserror (msp, 0);
  1739. #endif
  1740. } /* end of ml_gethostname */
  1741.  
  1742. /* ml_gethostid : unit -> string
  1743.  * Return the id of our host.
  1744.  */
  1745. #ifdef HPUX
  1746. void ml_gethostid (msp)
  1747.     MLState_ptr     msp;
  1748. {
  1749.     char        buf[SNLEN+1];
  1750.     ML_val_t    name;
  1751.     struct utsname utsname;
  1752.     uname(&utsname);
  1753.     bcopy ((char *)(utsname.idnumber), buf, SNLEN);
  1754.     buf[SNLEN] = '\0';  /* insure null termination */
  1755.     name = ML_alloc_string (msp, buf);
  1756.     RETURN(msp, name);
  1757. }
  1758. #else /* !HPUX */
  1759. void ml_gethostid (msp)
  1760.     MLState_ptr     msp;
  1761. {
  1762.     long    hostid;
  1763.     char        buf[sizeof(long)+1];
  1764.     ML_val_t    name;
  1765.  
  1766. #ifdef THINK_C
  1767.     /* Mac version not done yet */
  1768.     name = ML_alloc_string (msp, "357");
  1769. #else
  1770.     hostid = gethostid();
  1771.     bcopy ((char *)&hostid, buf, sizeof(long));
  1772.     buf[sizeof(long)] = '\0';  /* insure null termination */
  1773.     name = ML_alloc_string (msp, buf);
  1774. #endif
  1775.     RETURN(msp, name);
  1776.  
  1777. } /* end of ml_gethostid */
  1778. #endif
  1779.  
  1780. static int    blast_fd;    /* the file descriptor to blast to */
  1781.  
  1782. /* ml_blast_out : (int * 'a) -> 'a
  1783.  */
  1784. void ml_blast_out (msp, arg)
  1785.     MLState_ptr     msp;
  1786.     ML_val_t        arg;
  1787. {
  1788.     blast_fd        = REC_SELINT(arg, 0);
  1789.     /* blast_write doesn't work naturally on unboxed things.
  1790.        The hack to fix it is to blast out the tuple (fd,value)
  1791.        even though there's no need to save the fd; then blast_read
  1792.        can select out the value. 
  1793.     */
  1794.     msp->ml_arg = arg;
  1795.  /*   msp->mask = CONT_ARGS_MASK; shouldn't be necessary */
  1796.     callgc0 (msp, CAUSE_BLAST, 0);
  1797.  
  1798. } /* end of ml_blast_out */
  1799.  
  1800. /* blast_write:
  1801.  */
  1802. void blast_write (msp, start, end, ptr)
  1803.     MLState_ptr msp;
  1804.     int        start, end, ptr;
  1805. {
  1806. /*This version is to be used with a different version of 
  1807.   the ML code: that reads one word, uses that to determine
  1808.   how much of the rest to read.  (Current ML code just reads the
  1809.   entire file, making it impossible to blast_in two things in a row).
  1810.     int        hdr[4];
  1811.  
  1812.     hdr[0] = (int)(INT_CtoML(end-start+3*sizeof(int)));
  1813.     hdr[1] = start;
  1814.     hdr[2] = end;
  1815.     hdr[3] = ptr - start;
  1816. */
  1817.     int        hdr[3];
  1818.  
  1819.     hdr[0] = start;
  1820.     hdr[1] = end;
  1821.     hdr[2] = ptr - start;
  1822.  
  1823.     if (bulletproofWrite0 (blast_fd, hdr, sizeof(hdr)) 
  1824.     || bulletproofWrite0 (blast_fd, start, end-start))
  1825.          raise_syserror (msp, 0);
  1826.     else
  1827.     RETURN(msp, INT_CtoML(end-start+3*sizeof(int)));
  1828.  
  1829. } /* end of blast_write */
  1830.  
  1831.  
  1832. /* ml_blast_in : string -> 'a
  1833.  * Build an object from the string.  The string has a special header (produced
  1834.  * by blast_write).
  1835.  */
  1836. void ml_blast_in (msp, arg)
  1837.     MLState_ptr     msp;
  1838.     ML_val_t        arg;
  1839. {
  1840.     int            *obj = PTR_MLtoC(arg);
  1841.     int            start = obj[0];
  1842.     int            end = obj[1];
  1843.     int            offset = obj[2];
  1844.     int            *words = (obj + 3);
  1845.  
  1846.     (PTR_MLtoC(arg))[-1] = MAKE_DESC(12, TAG_string);
  1847.     relocate (start, end, words);
  1848.     RETURN(msp, REC_SEL(PTR_CtoML((int)words + offset),1));
  1849.  
  1850. } /* end of blast_in */
  1851.  
  1852.  
  1853. /* ml_export : int -> bool
  1854.  * Export the world to the given file and return false (the exported version
  1855.  * returns true).
  1856.  */
  1857. void ml_export (msp, arg)
  1858.     MLState_ptr     msp;
  1859.     ML_val_t        arg;
  1860. {
  1861.     int            fd = INT_MLtoC(arg);
  1862.     register int    i;
  1863.     extern int        isExported;
  1864.     extern MLState_ptr Exporters_State;
  1865. #if (MAX_PROCS > 1)
  1866.     extern void     check_suspended();
  1867.  
  1868.     check_suspended(msp);
  1869. #endif
  1870.  
  1871.   /* shed the unecessary stuff */
  1872.     /* msp->mask = CONT_ARGS_MASK; shouldn't be necessary */
  1873.     callgc0(msp, CAUSE_EXPORT, 0);
  1874.     callgc0(msp, CAUSE_EXPORT, 0);
  1875.  
  1876.   /* export */
  1877.     isExported = 1;
  1878.     Exporters_State = msp;
  1879.     i = export (fd);
  1880.     isExported = 0;
  1881.     Exporters_State = (MLState_ptr)0;
  1882.     if (i) raise_syserror (msp, 0);
  1883.     else RETURN(msp, ML_false);
  1884.  
  1885.  
  1886. } /* end of ml_export */
  1887.  
  1888.  
  1889. /* ml_gettime : unit -> (int * int * int * int * int * int)
  1890.  * Return the total CPU time, system time and garbage collection time used by this
  1891.  * process so far.
  1892.  */
  1893. void ml_gettime (msp)
  1894.     MLState_ptr     msp;
  1895. {
  1896.     ML_val_t    res;
  1897.     extern ML_val_t    t_sec, t_usec, s_sec, s_usec, g_sec, g_usec;
  1898.  
  1899.     timer();
  1900.     REC_ALLOC6 (msp, res, t_sec, t_usec, s_sec, s_usec, g_sec, g_usec);
  1901.     RETURN(msp, res);
  1902.  
  1903. } /* end of ml_gettime */
  1904.  
  1905.  
  1906. /* ml_timeofday : unit -> (int * int)
  1907.  * Return the time of day.
  1908.  */
  1909. void ml_timeofday (msp)    
  1910.      MLState_ptr     msp;
  1911. {
  1912.     struct timeval    t;
  1913.     ML_val_t        res;
  1914.  
  1915.     gettimeofday (&t, 0);
  1916.     REC_ALLOC2 (msp, res, INT_CtoML(t.tv_sec), INT_CtoML(t.tv_usec));
  1917.     RETURN(msp, res);
  1918.  
  1919. } /* end of ml_timeofday. */
  1920.  
  1921.  
  1922. /* ml_setitimer : (int * int * int * int * int) -> int
  1923.  * Set an interval timer; the first argument specifies which timer.
  1924.  */
  1925. void ml_setitimer (msp, arg)
  1926.     MLState_ptr     msp;
  1927.     ML_val_t        arg;
  1928. {
  1929. #ifdef THINK_C
  1930.     /* Mac version not done yet */
  1931.     raise_ThinkC_error(msp);
  1932. #else
  1933.     struct itimerval itv;
  1934.     register int    which;
  1935.  
  1936.     itv.it_interval.tv_sec  = REC_SELINT(arg, 1);
  1937.     itv.it_interval.tv_usec = REC_SELINT(arg, 2);
  1938.     itv.it_value.tv_sec     = REC_SELINT(arg, 3);
  1939.     itv.it_value.tv_usec    = REC_SELINT(arg, 4);
  1940.  
  1941.     switch (REC_SELINT(arg, 0)) {
  1942.       case 0: which = ITIMER_REAL; break;
  1943.       case 1: which = ITIMER_VIRTUAL; break;
  1944.       case 2: which = ITIMER_PROF; break;
  1945.     }
  1946.  
  1947.     if (setitimer (which, &itv, 0) == -1) {
  1948.         raise_syserror(msp, 0);
  1949.         return;
  1950.     }
  1951.     else
  1952.         RETURN(msp, ML_unit);
  1953. #endif
  1954. } /* end of ml_setitimer */
  1955.  
  1956.  
  1957. /* ml_setglobal : int array -> unit
  1958.  */
  1959. void ml_setglobal (msp, p)
  1960.     MLState_ptr     msp;
  1961.     ML_val_t        p;
  1962. {
  1963. #ifdef GLOBAL_INDX
  1964.     msp->ml_globalptr = p;
  1965. #endif
  1966.     RETURN(msp, ML_unit);
  1967.  
  1968. } /* end of ml_setglobal */
  1969.  
  1970.  
  1971. /* ml_mkcode : string -> (code_string * (unit -> unit))
  1972.  *
  1973.  * Turn a string into a code-string, and a bootable closure.  For the time
  1974.  * being, this just means flushing the I-cache and building a trivial closure,
  1975.  * but code will eventually live in its own space.
  1976.  */
  1977. void ml_mkcode (msp, arg)
  1978.     MLState_ptr        msp;
  1979.     ML_val_t        arg;
  1980. {
  1981.     int        begin = (int)PTR_MLtoC(arg);
  1982.     int        len = OBJ_LEN(arg) + 4;
  1983.     ML_val_t    closure, res;
  1984.  
  1985.     FlushICache (begin, len);
  1986.  
  1987.     REC_ALLOC1(msp, closure, PTR_CtoML((ML_val_t *)PTR_MLtoC(arg) + 1));
  1988.     REC_ALLOC2(msp, res, arg, closure);
  1989.  
  1990.     RETURN(msp, res);
  1991.  
  1992. } /* end of ml_mkcode */
  1993.  
  1994. /* ml_gc : int -> unit
  1995.  * Force a garbage collection of the specified level (0 == minor, 1 == major).
  1996.  */
  1997. void ml_gc (msp, level)
  1998.     MLState_ptr     msp;
  1999.     int            level;
  2000. {
  2001.     msp->ml_arg = ML_unit;
  2002.  
  2003.     switch (INT_MLtoC(level)) {
  2004.       /* msp->mask = CONT_ARGS_MASK; shouldn't be necessary */
  2005.       case 0: callgc0 (msp, CAUSE_MINOR, 0); break;
  2006.       default: callgc0 (msp, CAUSE_MAJOR, 0); break;
  2007.     }
  2008.  
  2009. } /* end of ml_gc */
  2010.  
  2011. /* ml_enablesig : (int * bool) -> unit
  2012.  * This function is called by ML code to enable/disable a given signal.  If the
  2013.  * second argument is true, the the signal is enabled, otherwise disabled.
  2014.  */
  2015. void ml_enablesig (msp, arg)
  2016.     MLState_ptr     msp;
  2017.     ML_val_t        arg;
  2018. {
  2019.     enable_sig (REC_SELINT(arg, 0), (REC_SEL(arg, 1) == ML_true));
  2020.     RETURN(msp, ML_unit);
  2021.  
  2022. } /* end of ml_enablesig. */
  2023.  
  2024. /* ml_masksigs : bool -> unit
  2025.  * Turn the masking of signals on and off.
  2026.  */
  2027. void ml_masksigs (msp, arg)
  2028.     MLState_ptr     msp;
  2029.     ML_val_t        arg;
  2030. {
  2031.     msp->maskSignals = (arg == ML_true);
  2032.     RETURN (msp, ML_unit);
  2033.  
  2034. } /* end of ml_masksigs */
  2035.  
  2036. /* ml_sigpause : unit -> unit
  2037.  * Pause until the next signal.  Note, this must not restart the system call
  2038.  * on EINTR.
  2039.  */
  2040. void ml_sigpause (msp)
  2041.     MLState_ptr     msp;
  2042. {
  2043. #ifdef THINK_C
  2044.     /* Mac version not done yet */
  2045.     raise_ThinkC_error(msp);
  2046. #else
  2047.     sigpause (0);
  2048.     RETURN(msp, ML_unit);
  2049. #endif
  2050. } /* end of ml_sigpause. */
  2051.  
  2052. #ifdef GETSTORELIST
  2053. /* ml_getstorelist : bool -> storelist
  2054.  */
  2055. void ml_getstorelist (msp, arg)
  2056.     MLState_ptr     msp;
  2057.     ML_val_t        arg;
  2058. {
  2059.     int           i;
  2060.     ML_val_t        res;
  2061.     extern int        preserving, store_preserve;
  2062.     extern ML_val_t uniq();
  2063.  
  2064.     /* msp->mask = CONT_ARGS_MASK; shouldn't be necessary */
  2065.     callgc0 (msp, CAUSE_STORE, 0);
  2066.     preserving = (arg != ML_false);
  2067.     res = uniq(store_preserve);
  2068.     store_preserve = (int)STORLST_nil;
  2069.     RETURN(msp, res);
  2070.  
  2071. } /* end of ml_getstorelist */
  2072. #endif
  2073.  
  2074.  
  2075. int icountM;
  2076.  
  2077. void ml_geticount (msp)
  2078.     MLState_ptr     msp;
  2079. {   int x;
  2080.     ML_val_t        res;
  2081. #ifdef ICOUNT
  2082.     x=(int)(msp->ml_icount);
  2083.     msp->ml_icount=0;
  2084. #else
  2085.     x=0;
  2086. #endif
  2087.     REC_ALLOC2 (msp, res, INT_CtoML(icountM), INT_CtoML(x));
  2088.     icountM=0;
  2089.     RETURN(msp, res);
  2090.  
  2091. }
  2092.  
  2093. /** The C function table **/
  2094.  
  2095. struct table_t {
  2096.     int            tag;
  2097.     ML_val_t        func;
  2098.     ML_val_t        name;
  2099.     ML_val_t        next;
  2100.     int            stag;
  2101.     char        str[16];
  2102. };
  2103.  
  2104. #define FUNCTION(ff,nn)                \
  2105.      {MAKE_DESC(3,TAG_record),            \
  2106.      PTR_CtoML(ff),                \
  2107.      0, /* fill in later */            \
  2108.      0, /* fill in later */            \
  2109.      MAKE_DESC(sizeof(nn)-1,TAG_string),    \
  2110.      nn}
  2111.  
  2112. struct table_t externlist0[] =
  2113.     {
  2114. /*                                  "xxxxxxxxxxxxxxxx" MAX NAME LENGTH (16) */
  2115.     FUNCTION (ml_syscall,        "syscall"),
  2116.     FUNCTION (ml_openf,        "openf"),
  2117.     FUNCTION (ml_closef,        "closef"),
  2118.     FUNCTION (ml_connect_unix,  "connect_unix"),
  2119.     FUNCTION (ml_connect_inet,  "connect_inet"),
  2120.     FUNCTION (ml_link,        "link"),
  2121.     FUNCTION (ml_unlink,        "unlink"),
  2122.     FUNCTION (ml_dup,        "dup"),
  2123.     FUNCTION (ml_wait_for_in,   "wait_for_in"),
  2124.     FUNCTION (ml_read,        "read"),
  2125.     FUNCTION (ml_readi,        "readi"),
  2126.     FUNCTION (ml_write,        "write"),
  2127.     FUNCTION (ml_writei,        "writei"),
  2128.     FUNCTION (ml_writev,        "writev"),
  2129.     FUNCTION (ml_lseek,        "lseek"),
  2130.     FUNCTION (ml_send_obd,        "send_obd"),
  2131.     FUNCTION (ml_getdirent,        "getdirent"),
  2132.     FUNCTION (ml_chdir,        "chdir"),
  2133.     FUNCTION (ml_mkdir,        "mkdir"),
  2134.     FUNCTION (ml_readlink,        "readlink"),
  2135.     FUNCTION (ml_truncate,        "truncate"),
  2136.     FUNCTION (ml_umask,        "umask"),
  2137.     FUNCTION (ml_chmod,        "chmod"),
  2138.     FUNCTION (ml_access,        "access"),
  2139.     FUNCTION (ml_getfid,        "getfid"),
  2140.     FUNCTION (ml_getmod,        "getmod"),
  2141.     FUNCTION (ml_ftype,        "ftype"),
  2142.     FUNCTION (ml_getownid,        "getownid"),
  2143.     FUNCTION (ml_fsize,        "fsize"),
  2144.     FUNCTION (ml_atime,        "atime"),
  2145.     FUNCTION (ml_ctime,        "ctime"),
  2146.     FUNCTION (ml_mtime,        "mtime"),
  2147.     FUNCTION (ml_isatty,        "isatty"),
  2148.     FUNCTION (ml_select,        "select"),
  2149.     FUNCTION (ml_pipe,        "pipe"),
  2150.     FUNCTION (ml_fionread,        "fionread"),
  2151.     FUNCTION (ml_system,        "system"),
  2152.     FUNCTION (ml_exec,        "exec"),
  2153.     FUNCTION (ml_exit,        "exit"),
  2154.     FUNCTION (ml_argv,        "argv"),
  2155.     FUNCTION (ml_environ,        "environ"),
  2156.     FUNCTION (ml_getpid,        "getpid"),
  2157.     FUNCTION (ml_getuid,        "getuid"),
  2158.     FUNCTION (ml_getgid,        "getgid"),
  2159.     FUNCTION (ml_gethostname,   "gethostname"),
  2160.     FUNCTION (ml_gethostid,     "gethostid"),
  2161.     FUNCTION (ml_blast_out,        "blas"),
  2162.     FUNCTION (ml_blast_in,        "salb"),
  2163.     FUNCTION (ml_export,        "export"),
  2164.     FUNCTION (ml_gettime,        "gettime"),
  2165.     FUNCTION (ml_timeofday,        "timeofday"),
  2166.     FUNCTION (ml_setitimer,        "setitimer"),
  2167.     FUNCTION (ml_setglobal,        "setg"),
  2168.     FUNCTION (ml_mkcode,        "mkcode"),
  2169.     FUNCTION (ml_gc,        "gc"),
  2170.     FUNCTION (ml_enablesig,        "enablesig"),
  2171.     FUNCTION (ml_masksigs,        "masksigs"),
  2172.     FUNCTION (ml_sigpause,        "sigpause"),
  2173.     FUNCTION (ml_geticount,     "geticount"),
  2174.     FUNCTION (ml_acquire_proc,  "acquire_proc"),
  2175.     FUNCTION (ml_release_proc,  "release_proc"),
  2176.     FUNCTION (ml_spin_lock,     "spin_lock"),
  2177.         FUNCTION (ml_max_procs,     "max_procs"),
  2178. #ifdef GETSTORELIST
  2179.     FUNCTION (ml_getstorelist,  "getstorelist"),
  2180. #endif
  2181. /*                                  "xxxxxxxxxxxxxxxx" MAX NAME LENGTH (16) */
  2182.     };
  2183. #define NEXTERNS    (sizeof(externlist0)/sizeof(struct table_t))
  2184.  
  2185. /* init_externlist:
  2186.  * Initialize the extern list.
  2187.  */
  2188. void init_externlist ()
  2189. {
  2190.     int            i;
  2191.     struct table_t  *p = (struct table_t *)INT_CtoML(0);
  2192.  
  2193.     for (i = NEXTERNS;  --i >= 0; ) {
  2194.     externlist0[i].next = PTR_CtoML(p);
  2195.     externlist0[i].name = PTR_CtoML(externlist0[i].str);
  2196.     p = (struct table_t *)&(externlist0[i].func);
  2197.     }
  2198.  
  2199. } /* end of init_externlist */
  2200.  
  2201. #ifdef THINK_C
  2202. int nexterns = NEXTERNS;
  2203. int old_extern[NEXTERNS];
  2204. #endif
  2205.